home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tclm_1_0.lha / tclm-1.0 / mrecord < prev    next >
Text File  |  1993-08-16  |  4KB  |  155 lines
  1. #!/usr/local/bin/tclm -f
  2. #
  3. # Copyright (c) 1993 Michael B. Durian.  All rights reserved.
  4. #
  5. # Redistribution and use in source and binary forms, with or without
  6. # modification, are permitted provided that the following conditions
  7. # are met:
  8. # 1. Redistributions of source code must retain the above copyright
  9. #    notice, this list of conditions and the following disclaimer.
  10. # 2. Redistributions in binary form must reproduce the above copyright
  11. #    notice, this list of conditions and the following disclaimer in the
  12. #    documentation and/or other materials provided with the distribution.
  13. # 3. All advertising materials mentioning features or use of this software
  14. #    must display the following acknowledgement:
  15. #    This product includes software developed by Michael B. Durian.
  16. # 4. The name of the the Author may be used to endorse or promote 
  17. #    products derived from this software without specific prior written 
  18. #    permission.
  19. #
  20. # THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED 
  21. # WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  22. # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  
  23. # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
  24. # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  25. # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  26. # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  27. # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  28. # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  29. # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  30. # SUCH DAMAGE.
  31.  
  32. # mrecord,v 1.1 1993/05/06 02:51:08 durian Exp
  33.  
  34. if {! [midiplayable]} {
  35.     puts stderr [concat "Cannot record.  Tclm was not compiled with the " \
  36.         "record functionality turned on."]
  37.     exit 1
  38. }
  39.  
  40. set repeat {}
  41. set tracks {}
  42. set speed {}
  43. set play ""
  44. set reltempo ""
  45. set rec_file_name ""
  46. set play_file_name ""
  47.  
  48. proc parse_arg {args} {
  49.     global repeat
  50.     global tracks
  51.     global speed
  52.     global play_file_name
  53.     global rec_file_name
  54.  
  55.     # strip away extra {}'s
  56.     set argv [lindex $args 0]
  57.     set argc [llength $argv]
  58.     if {$argc > 1 && [string compare [lindex $argv 0] "-f"] == 0} {
  59.         incr argc -2
  60.         set argv [lrange $argv 2 end]
  61.     }
  62.     for {set i 0} {$i < $argc} {incr i} {
  63.  
  64.         set arg [lindex $argv $i]
  65.         case $arg in \
  66.         -repeat {
  67.             set repeat repeat
  68.         } -tracks {
  69.             set tracks [lindex $argv [incr i]]
  70.         } -speed {
  71.             set speed [lindex $argv [incr i]]
  72.         } -pfile {
  73.             set play_file_name [lindex $argv [incr i]]
  74.         } default {
  75.             if {[string length $rec_file_name] != 0} {
  76.                 Usage
  77.             } else {
  78.                 set rec_file_name [lindex $argv $i]
  79.             }
  80.         }
  81.     }
  82. }
  83.  
  84. proc Usage {} {
  85.     puts stderr {Usage: mrecord [-pfile play_file [-repeat] \
  86. [-tracks track_list] [-speed speed]] record_file}
  87.     exit 1
  88. }
  89.  
  90. parse_arg $argv
  91.  
  92. set background ""
  93. set rmfile [midimake]
  94. midiconfig $rmfile format 0
  95. midiconfig $rmfile tracks 1
  96.  
  97. if {[string length $play_file_name] == 0} {
  98.     if {[string length $repeat] != 0} {
  99.         Usage
  100.     }
  101.     if {[string length $tracks] != 0} {
  102.         Usage
  103.     }
  104.     if {[string length $speed] != 0} {
  105.         Usage
  106.     }
  107.     set pfile ""
  108.     set pmfile ""
  109.     set background background
  110. } else {
  111.     if {[string length $repeat] != 0} {
  112.         set background background
  113.     }
  114.  
  115.     if {[llength $tracks] != 0} {
  116.         set tracks "tracks \"$tracks\""
  117.     } else {
  118.         set tracks ""
  119.     }
  120.  
  121.     if {[string length $speed] != 0} {
  122.         set reltempo "reltempo $speed"
  123.     } else {
  124.         set reltempo ""
  125.     }
  126.     set pfile [open $play_file_name "r"]
  127.     set pmfile [midiread $pfile]
  128.     close $pfile
  129.  
  130.     set play "play $pmfile"
  131.  
  132.     midiconfig $rmfile division [midiconfig $pmfile division]
  133. }
  134.  
  135. if {[string length $background] == 0} {
  136.     eval "midirecord $background $play $repeat $tracks $reltempo $rmfile"
  137. } else {
  138.     set pid [eval \
  139.         "midirecord $background $play $repeat $tracks $reltempo $rmfile"]
  140.     puts stdout "Press return to stop recording"
  141.     gets stdin
  142.     midistop $pid $rmfile
  143. }
  144.  
  145. midiput $rmfile 0 0 metaeot
  146.  
  147. set rfile [open $rec_file_name "w"]
  148. midiwrite $rmfile $rfile
  149. close $rfile
  150. if {[string length $pmfile] != 0} {
  151.     midifree $pmfile
  152. }
  153. midifree $rmfile
  154. exit 0
  155.